home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
scope
/
101-125
/
scopedisk122
/
bassub
/
intuits.sub
< prev
next >
Wrap
Text File
|
1995-03-19
|
9KB
|
313 lines
'Subroutines for creating gadgets and requestors without using
'Amiga intuition.
REM SimpleRequest
'Simple requestor box
'x%, y% = x and y offsets in lines
'msg$ = single line of text for message
'oktxt$, cantxt$ = OK and CANCEL button text
SUB SimpleRequest(x%,y%,msg$,oktxt$,cantxt$)
SHARED maxlen%,ScrID%,which%,BoxIndex%
height%=PEEKW(WINDOW(8)+58)
winwidth%=maxlen%*(8-2*(height%=9))+40
COLOR 2,0,0
LINE (x%*8-16,y%*8-12)-(winwidth%+x%*8,20+y%*8),1,bf
LINE (x%*8-16,y%*8-12)-(winwidth%+x%*8,20+y%*8),2,b
LINE (x%*8-19,y%*8-13)-(winwidth%+x%*8+3,21+y%*8),3,b
LOCATE y%,x% : PRINT " ";msg$
LOCATE y%+2,x%
PRINT " ";
CALL SmallTxBox(oktxt$)
PRINT " ";
CALL SmallTxBox(cantxt$)
COLOR 1,0,1
END SUB
REM SmallTxBox
'Gadget box with text in msg$
SUB SmallTxBox(msg$) STATIC
SHARED x1%(),y1%(),x2%(),y2%()
SHARED BoxIndex%
x1%=WINDOW(4) : y1%=WINDOW(5)-8
PRINT " ";msg$;" ";
x2%=WINDOW(4) : y2%=y1%+11
CALL Box(BoxIndex%,x1%,y1%,x2%,y2%)
BoxIndex%=BoxIndex%+1
PRINT SPC(1);
END SUB
REM SmallTxGad
'Text gadget without a box
SUB SmallTxGad(msg$) STATIC
SHARED x1%(),y1%(),x2%(),y2%()
SHARED BoxIndex%
x1%=WINDOW(4) : y1%=WINDOW(5)-7
PRINT " ";msg$;" ";
x2%=WINDOW(4) : y2%=y1%+10
CALL NoBoxGad(BoxIndex%,x1%,y1%,x2%,y2%)
BoxIndex%=BoxIndex%+1
PRINT SPC(1);
END SUB
REM NewStringRequest
'String requestor
'default$ = returned string, can also contain a default string
SUB NewStringRequest(x%,y%,msg$,default$) STATIC
SHARED maxlen%,ScrID%,which%,BoxIndex%
height%=PEEKW(WINDOW(8)+58)
winwidth%=maxlen%*(8-2*(height%=9))+40
COLOR 2,0,0
LINE (x%*8-16,y%*8-6)-(winwidth%+x%*8,19+y%*8),1,bf
LINE (x%*8-16,y%*8-6)-(winwidth%+x%*8,19+y%*8),2,b
LINE (x%*8-19,y%*8-7)-(winwidth%+x%*8+3,20+y%*8),3,b
PRINT PTAB(x%*8+2,y%*8+3);msg$
PRINT PTAB(x%*8+2,y%*8+14);
COLOR 1,0,1
CALL SmallTxBox(default$+SPACE$(1+maxlen%-LEN(default$))) 'reserve space
Xpos%=x%+1 : Ypos%=CSRLIN 'for GetString
CALL GetString(Xpos%,Ypos%,default$)
END SUB
REM StringRequest
'Same as above, but more configurable
'title$ = requestor title string
'msg$ = requestor message
'b1$, b2$ = OK and CANCEL button text
SUB StringRequest(x%,y%,title$,msg$,b1$,b2$,default$) STATIC
SHARED maxlen%,ScrID%,which%,BoxIndex%
BoxIndex%=1
height%=PEEKW(WINDOW(8)+58)
winwidth%=maxlen%*(8-2*(height%=9))+40
COLOR 2,0,0
LINE (x%*8-16,y%*8-1)-(winwidth%+x%*8,54+y%*8),1,bf
LINE (x%*8-16,y%*8-1)-(winwidth%+x%*8,54+y%*8),2,b
LINE (x%*8-19,y%*8-2)-(winwidth%+x%*8+3,55+y%*8),3,b
COLOR 0,0,0
PRINT PTAB(x%*8+(maxlen%*8-LEN(title$))/2,y%*8+7);title$
COLOR 2,0,0
PRINT PTAB(x%*8+2,y%*8+18);msg$
PRINT PTAB(x%*8+2,y%*8+30);
COLOR 1,0,1
CALL SmallTxBox(default$+SPACE$(1+maxlen%-LEN(default$))) 'reserve space
Xpos%=x%+1 : Ypos%=CSRLIN 'for GetString
COLOR 2,0,0
PRINT PTAB(x%*8+2,y%*8+48) : CALL SmallTxBox(b1$)
PRINT PTAB(x%*8+(maxlen%+1-LEN(b2$))*8+2,y%*8+48) : CALL SmallTxBox(b2$)
COLOR 1,0,1
which%=0
WHILE which%<=1
CALL WaitBox(which%) 'Get box #
IF which%=1 THEN 'if GetString
CALL GetString(Xpos%,Ypos%,default$)
END IF
WEND 'must be Open or Cancel
CALL FlashRelease(which%) 'Flash the box
IF which%=BoxIndex%-1 THEN default$=""
END SUB
REM EasyAlert
'An Alert requestor with two lines of text, msg1$ and msg2$
'Buttons are pre-set to Continue and Abort
'which% = returns 1 for continue and 2 for abort
SUB EasyAlert(msg1$,msg2$,which%) STATIC
'Easy Alert. Pass two lines of text
'in msg1$,msg2$. Receive button status
'(1=retry, 2=cancel) in (which%)
CALL EasyRequest(msg1$,msg2$,"Continue","Abort",which%)
END SUB
REM EasyRequest
'Same as above, but can configure buttons with b1$ and b2$ text
SUB EasyRequest(msg1$,msg2$,b1$,b2$,which%) STATIC
'Generalized requester
'Pass two messages lines in msg1$,msg2$
'and two button prompts in b1$,b2$
'Confine text to a width of 16
' button (usually Cancel)
'No buttons are highlighted
SHARED BoxIndex%,ScrID%
SHARED x1%(),y1%(),x2%(),y2%()
BoxIndex%=1
height%=PEEKW(WINDOW(8)+58)
winwidth%=20*(8-2*(height%=9))+30
WINDOW 2,"System Request",(0,0)-(winwidth%,50),0,ScrID%
PRINT : PRINT TAB(11-LEN(msg1$)/2);msg1$
PRINT TAB(11-LEN(msg2$)/2);msg2$ : PRINT
LOCATE ,2
TxBox b1$
PRINT TAB(20-LEN(b2$));
TxBox b2$
which%=0
CALL WaitBox(which%)
CALL FlashRelease(which%)
WINDOW CLOSE 2
END SUB
REM OneButtonRequest
'Same as above, but with one button rather than two
SUB OneButtonRequest(msg1$,msg2$,b1$,which%) STATIC
SHARED BoxIndex%,ScrID%
SHARED x1%(),y1%(),x2%(),y2%()
BoxIndex%=1
height%=PEEKW(WINDOW(8)+58)
winwidth%=20*(8-2*(height%=9))+30
WINDOW 2,"System Request",(0,0)-(winwidth%,45),0,ScrID%
PRINT : PRINT TAB(11-LEN(msg1$)/2);msg1$
PRINT TAB(11-LEN(msg2$)/2);msg2$ : PRINT
LOCATE ,(20-LEN(b1$))/2
TxBox b1$
which%=0
CALL WaitBox(which%)
CALL FlashRelease(which%)
WINDOW CLOSE 2
END SUB
REM FlashRelease
SUB FlashRelease(which%) STATIC
'Flashes button (which%), waits for
'release of mouse button
'if mouse moved during release,
'global variable RelVerify is set to null,
'else is -1 (true).
SHARED x1%(),y1%(),x2%(),y2%(),work%()
SHARED RelVerify%
'These two lines flash the box
GET (x1%(which%),y1%(which%))-(x2%(which%),y2%(which%)),work%
PUT (x1%(which%),y1%(which%)),work%,PRESET
ix%=MOUSE(1) : iy%=MOUSE(2) : RelVerify%=-1
WHILE MOUSE(0)<>0
IF MOUSE(1)<>ix% OR MOUSE(2)<>iy% THEN RelVerify%=0
WEND
'This line restores the box
PUT (x1%(which%),y1%(which%)),work%,PSET
END SUB
REM TxBox
SUB TxBox(msg$) STATIC
'TxBox automatically draws a box
'around text in (msg$), stores box
'vertices in corner arrays
'Sub BOX automatically increments
'global index BoxIndex%
SHARED x1%(),y1%(),x2%(),y2%()
SHARED BoxIndex%
x1%=WINDOW(4) : y1%=WINDOW(5)-10
PRINT " ";msg$;" ";
x2%=WINDOW(4) : y2%=y1%+14
CALL Box(BoxIndex%,x1%,y1%,x2%,y2%)
BoxIndex%=BoxIndex%+1
PRINT SPC(1);
END SUB
REM Box
SUB Box(i%,x1%,y1%,x2%,y2%) STATIC
'Draw and store a box (i) whose corner
'coords are (x1,y1)-(x2,y2)
'Can be used to change a box's coords
SHARED x1%(),y1%(),x2%(),y2%()
IF x2%<x1% THEN SWAP x1%,x2%
LINE (x1%,y1%)-(x2%,y2%),1-(WINDOW(6)>1),b
LINE (x1%,y1%)-(x2%-1,y2%-1),2-(WINDOW(6)>1),b
x1%(i%)=x1% : y1%(i%)=y1% : x2%(i%)=x2% : y2%(i%)=y2%
END SUB
REM NoBoxGad
SUB NoBoxGad(i%,x1%,y1%,x2%,y2%) STATIC
'Same as Box(), but doesn't draw a box
SHARED x1%(),y1%(),x2%(),y2%()
IF x2%<x1% THEN SWAP x1%,x2%
x1%(i%)=x1% : y1%(i%)=y1% : x2%(i%)=x2% : y2%(i%)=y2%
END SUB
REM CheckBox
'Checks a box when selected. Actually, changes box color and
'wipes string
SUB CheckBox(i%,flag%) STATIC
'Check a box
'Pass variable (flag)
'for on/off (-1/0)
SHARED x1%(),y1%(),x2%(),y2%()
x1%=x1%(i%)+1 : y1%=y1%(i%)+1
x2%=x2%(i%)-1 : y2%=y2%(i%)-1
COLOR 1,0,2
LINE (x1%+1,y1%+1)-(x2%-1,y2%-1),WINDOW(6)*-(flag%<>0),bf
COLOR 1,0,1
END SUB
REM BlankBox
SUB BlankBox(i%) STATIC
SHARED x1%(),y1%(),x2%(),y2%()
x1%=x1%(i%)-3 : y1%=y1%(i%)-3
x2%=x2%(i%)+3 : y2%=y2%(i%)+3
LINE (x1%+1,y1%)-(x2%,y2%),1,bf
END SUB
REM WaitBox
SUB WaitBox(which%) STATIC
'Wait for a box to be selected
'return box number in (which%)
which%=0
WHILE which%=0
SLEEP
CALL WhichBox(which%)
WEND
EXIT SUB
END SUB
REM WhichBox
SUB WhichBox(which%) STATIC
'See if a box is selected,
'otherwise (which%)=0
'Used to poll for box selection
SHARED x1%(),y1%(),x2%(),y2%(),BoxIndex%
IF MOUSE(0)=0 THEN EXIT SUB
x%=MOUSE(1) : y%=MOUSE(2) : i%=1
WHILE i%<BoxIndex% AND NOT (x%>x1%(i%) AND x%<x2%(i%) AND y%>y1%(i%) AND y%<y2%(i%))
INCR i%
WEND
which%=i%
IF i%=BoxIndex% THEN which%=0
END SUB
REM GetString
SUB GetString(Xpos%,Ypos%,default$) STATIC
'Customized GetString integrated for
'use with other box gadgets
'Exits when RETURN is pressed or
'when another button is clicked
'(button selected is returned in
' global variable which%)
'Provide your own border.
'Pass position of field (Xpos%,Ypos%)
'Pass default prompt in default$,
'find return in default$
'global variable maxlen%=length of edit field in characters
'(default length is 40)
SHARED maxlen%,which%
answer$=default$
IF maxlen%=0 THEN maxlen%=40
'Cursor appears at end of default string
csr%=LEN(default$)+1
k$=""
WHILE k$<>CHR$(13)
LOCATE Ypos%,Xpos%+1:PRINT default$;" ";
LOCATE Ypos%,Xpos%+csr%
COLOR 0,WINDOW(6) 'cursor is max color
PRINT MID$(default$+" ",csr%,1)
COLOR 1,0:k$=""
WHILE k$="":k$=INKEY$
SLEEP
CALL WhichBox(i%)
IF i%>1 AND i%<>which% THEN which%=i%:k$=CHR$(13)
WEND
LOCATE Ypos%,Xpos%+1:PRINT default$;" ";
k%=ASC(k$)
IF k%>=32 AND k%<127 THEN
default$=LEFT$(default$,csr%-1)+k$+MID$(default$,csr%)
default$=LEFT$(default$,maxlen%)
csr%=csr%-(csr%<maxlen%)
END IF
IF k%=31 OR k%=8 THEN csr%=csr%+(csr%>1)
IF k%=127 OR k%=8 THEN
default$=LEFT$(default$,csr%-1)+MID$(default$,csr%+1)
END IF
IF k%=30 THEN csr%=csr%-(csr%<maxlen%)
WEND
END SUB
RETURN